home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vampso2a / mhdock.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-31  |  4.6 KB  |  124 lines
  1. VERSION 5.00
  2. Begin VB.UserControl MHDock 
  3.    Alignable       =   -1  'True
  4.    CanGetFocus     =   0   'False
  5.    ClientHeight    =   465
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   480
  9.    InvisibleAtRuntime=   -1  'True
  10.    Picture         =   "MHDock.ctx":0000
  11.    ScaleHeight     =   465
  12.    ScaleWidth      =   480
  13.    ToolboxBitmap   =   "MHDock.ctx":0442
  14. Attribute VB_Name = "MHDock"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = True
  17. Attribute VB_PredeclaredId = False
  18. Attribute VB_Exposed = False
  19. Option Explicit
  20. 'Default Property Values:
  21. Const m_def_xDock = 360
  22. Const m_def_yDock = 360
  23. Const m_def_DockEnabled = True
  24. ' Saved local variables
  25. Dim seVars As seVarsType, hMem As Long
  26. Event Moved(xDockPos As Single, yDockPos As Single)
  27. Attribute Moved.VB_Description = "Event fires when the form is moved."
  28. ' Copy from seVars structure to locked memory
  29. Private Sub seVarsChanged()
  30.     If hMem Then CopyMemory ByVal hMem, seVars, LenB(seVars)
  31. End Sub
  32. ' Fired from the subclass procedure to cause a form Moved event
  33. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  34.     If hMem Then
  35.         X = X \ Screen.TwipsPerPixelX
  36.         Y = Y \ Screen.TwipsPerPixelY
  37.         RaiseEvent Moved(X, Y)
  38.     End If
  39. End Sub
  40. ' Don't allow resizing during design
  41. Private Sub UserControl_Resize()
  42.     Height = 465: Width = 480
  43. End Sub
  44. ' Reset the WndProc if needed
  45. Private Sub UserControl_Terminate()
  46.     On Local Error Resume Next
  47.     SetHook seVars.lParenthWnd, False, seVars.origWndProc
  48.     DeleteSetting "MHDock", "hMem", CStr(seVars.lParenthWnd)
  49.     GlobalFree hMem
  50. End Sub
  51. Public Property Get DockEnabled() As Boolean
  52. Attribute DockEnabled.VB_Description = "Active docking capabilities"
  53.     DockEnabled = seVars.bDockEnabled
  54. End Property
  55. Public Property Let DockEnabled(ByVal New_DockEnabled As Boolean)
  56.     seVars.bDockEnabled = New_DockEnabled
  57.     Call seVarsChanged
  58.     PropertyChanged "DockEnabled"
  59. End Property
  60. Public Property Get xDock() As Long
  61. Attribute xDock.VB_Description = "Horizontal docking offset in Twips."
  62.     xDock = seVars.lxDock
  63. End Property
  64. Public Property Let xDock(ByVal New_xDock As Long)
  65.     seVars.lxDock = New_xDock
  66.     Call seVarsChanged
  67.     PropertyChanged "xDock"
  68. End Property
  69. Public Property Get yDock() As Long
  70. Attribute yDock.VB_Description = "Vertical docking offset in Twips."
  71.     yDock = seVars.lyDock
  72. End Property
  73. Public Property Let yDock(ByVal New_yDock As Long)
  74.     seVars.lyDock = New_yDock
  75.     Call seVarsChanged
  76.     PropertyChanged "yDock"
  77. End Property
  78. Private Sub UserControl_InitProperties()
  79.     seVars.lxDock = m_def_xDock
  80.     seVars.lyDock = m_def_yDock
  81.     Call seVarsChanged
  82. End Sub
  83. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  84.     seVars.lxDock = PropBag.ReadProperty("xDock", m_def_xDock)
  85.     seVars.lyDock = PropBag.ReadProperty("yDock", m_def_yDock)
  86.     seVars.bDockEnabled = PropBag.ReadProperty("DockEnabled", m_def_DockEnabled)
  87.     If Ambient.UserMode Then    ' Run-time only
  88.         Dim h As Long, f As Object, R As RECT
  89.         
  90.         ' Find the parent form's hWnd
  91.         For Each f In ParentControls
  92.             If TypeOf f Is Form Then
  93.                 seVars.lParenthWnd = f.hwnd
  94.                 Exit For
  95.             End If
  96.         Next
  97.         If seVars.lParenthWnd = 0 Then Exit Sub
  98.         
  99.         seVars.lseHwnd = hwnd
  100.         
  101.         ' Retrieve the parent handle and, if the window is top level, the system tray handle
  102.         seVars.lTophWnd = GetParent(seVars.lParenthWnd)
  103.         If seVars.lTophWnd = 0 Then
  104.             seVars.lTophWnd = GetDesktopWindow()
  105.             If seVars.lTrayhWnd = 0 Then seVars.lTrayhWnd = FindWindow("Shell_TrayWnd", vbNullString)
  106.         End If
  107.         
  108.         ' Store the original WndProc address in seVars, allocate fixed global
  109.         ' memory, and copy the seVars structure to the fixed memory
  110.         seVars.origWndProc = GetWindowLong(seVars.lParenthWnd, GWL_WNDPROC)
  111.         hMem = GlobalAlloc(GPTR, LenB(seVars))
  112.         SaveSetting "MHDock", "hMem", CStr(seVars.lParenthWnd), CStr(hMem)
  113.         Call seVarsChanged
  114.         
  115.         ' Hook the parent WndProc
  116.         SetHook seVars.lParenthWnd, True, seVars.origWndProc
  117.     End If
  118. End Sub
  119. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  120.     Call PropBag.WriteProperty("xDock", seVars.lxDock, m_def_xDock)
  121.     Call PropBag.WriteProperty("yDock", seVars.lyDock, m_def_yDock)
  122.     Call PropBag.WriteProperty("DockEnabled", seVars.bDockEnabled, m_def_DockEnabled)
  123. End Sub
  124.